Modelos Multiclasse - Classificação de Vidros para Análise Forense
APRESENTAÇÃO
Universidade Federal da Bahia - UFBA
Escola Politécnica
Programa de Pós-Graduação em Engenharia Industrial - PEI/UFBA
Departamento de Engenharia Química - DEQ
ENG436 - Tópicos Especiais em Engenharia
O presente trabalho foi desenvolvido como parte de avaliação para a disciplina Tópicos Especiais em Engenharia, ministrada pela docente Karla Esquerre da Escola Politécnica da UFBA.
DESENVOLVIMENTO
Vestígios deixados na cena de um crime podem ser de extrema importância para a resolução do mesmo. Utilizando dos conhecimentos que envolvem o aprendizado de máquina, é possível construir modelos preditivos que deem suporte as análises e obter importantes informações sobre padrões de banco de dados criminológicos.
Diferentes estudos utilizam algoritmos de aprendizado de máquina para tarefas de classificação, procurando otimizar os modelos com variadas técnicas. No presente trabalho fora proposto um modelo preditivo de classificação de vidro multiclasse, utilizando do algoritmo de Random Forest para diferentes cenários de variáveis e técnicas de balanceamento de classes.
DATASET E CODE
O presente dataset em análise é um conjunto de objetos de identificação de vidro da UC Irvine Machine Learning Repository, disponível no Kaggle, contendo 10 atributos, sendo a resposta o tipo do vidro (label / rótulo).
Os atributos em análise são:
01- RI: Índice de Refração;
02- Na: Sódio (medição unitária: porcentagem em peso no óxido correspondente, como são os atributos 03-09);
03- Mg: Magnésio;
04- Al: Alumínio;
05- Si: Silício;
06- K: Potássio;
07- Ca: Cálcio;
08- Ba: Bário;
09- Fe: Ferro;
10- Tipo de Vidro;
X1 - Vidro float de construções;
X2 - Vidro “não” float de construções;
X3 - Vidro float de veículos;
X5 - Vidro de contêineres;
X6 - Utensílios de mesa (prato, xícara, etc);
X7 - headlamps.
Abaixo, iniciamos o código indicando o caminho da pasta de trabalho, carregando os pacotes demandados e o dataset a ser analisado. O uso do pacote pacman foi idealizado em facilitar a reprodutibilidade, dinamicidade de instalação e carregamento de pacotes. Especificamente o pacote gg3D demanda que o download seja realizado diretamente do git, e para tal, utilizamos o pacote remotes.
setwd("D:/PEI/Doc/Disciplinas/Topicos/topicos_eng436")
# setwd("C:/Users/MARCELLO/Desktop/ENG436/topicos_eng436")
{
if (!require("pacman")) install.packages("pacman")
pacman::p_load(dplyr, readxl, ggplot2, GGally, skimr,
plotly, knitr, tidyr, shiny, caret, randomForest,
reshape2, tibble, rmdformats, cowplot,
car, bestNormalize, forcats)
if (!require("gg3D")) remotes::install_github("AckerDWM/gg3D")
library(gg3D)
}
# Tema
tema <- theme_bw() +
theme(axis.title = element_text(color = "black", size = 18, face = "bold"),
axis.text.x = element_text(color = "black", size = 16, face = "bold"),
axis.text.y = element_text(color = "black", size = 16, face = "bold"),
legend.text = element_text(color = "black", size = 12, face = "bold"),
legend.title = element_text(color = "black", size = 14, face = "bold"),
plot.title = element_text(color = "black", size = 18, face = "bold"))
set.seed(42)
dataset <- readxl::read_excel("glass.xlsx")
O primeiro passo para qualquer estruturação ou análise, é o conhecimento acerca da estrutura inicial dos dados. Para tanto, utilizaremos a função glimpse do pacote dplyr.
Observations: 214
Variables: 10
$ RI <dbl> 152101, 151761, 151618, 151766, 151742, 151596, 151743, 151756...
$ Na <chr> "13.64", "13.89", "13.53", "13.21", "13.27", "12.79", "13.3", ...
$ Mg <chr> "4.49", "3.6", "3.55", "3.69", "3.62", "3.61", "3.6", "3.61", ...
$ Al <chr> "1.1", "1.36", "1.54", "1.29", "1.24", "1.62", "1.14", "1.05",...
$ Si <chr> "71.78", "72.73", "72.99", "72.61", "73.08", "72.97", "73.09",...
$ K <chr> "0.06", "0.48", "0.39", "0.57", "0.55", "0.64", "0.58", "0.57"...
$ Ca <chr> "8.75", "7.83", "7.78", "8.22", "8.07", "8.07", "8.17", "8.24"...
$ Ba <chr> "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0...
$ Fe <chr> "0", "0", "0", "0", "0", "0.26", "0", "0", "0", "0.11", "0.24"...
$ Type <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,...
Podemos observar que apenas a variável preditora RI está como dbl (double). Deste modo, transformaremos as chr (character) para números, tendo em vista a necessidade para exploração descritiva e construção de modelos. A variável Type é o label (rótulo) de nossas classes de vidro, e essas deverão passar a ser fatores, sendo renomeada para Tipo.
A variável RI será dividida por \(10^5\) para adequação de escala real.
df <- dataset %>%
dplyr::mutate_if(is.character, as.numeric) %>%
dplyr::mutate(Tipo = as.factor(Type),
RI = RI/(10^5)) %>%
dplyr::select(-Type)
df_x <- df
levels(df$Tipo) <- make.names(levels(factor(df$Tipo)))
dplyr::glimpse(df)Observations: 214
Variables: 10
$ RI <dbl> 1.52101, 1.51761, 1.51618, 1.51766, 1.51742, 1.51596, 1.51743,...
$ Na <dbl> 13.64, 13.89, 13.53, 13.21, 13.27, 12.79, 13.30, 13.15, 14.04,...
$ Mg <dbl> 4.49, 3.60, 3.55, 3.69, 3.62, 3.61, 3.60, 3.61, 3.58, 3.60, 3....
$ Al <dbl> 1.10, 1.36, 1.54, 1.29, 1.24, 1.62, 1.14, 1.05, 1.37, 1.36, 1....
$ Si <dbl> 71.78, 72.73, 72.99, 72.61, 73.08, 72.97, 73.09, 73.24, 72.08,...
$ K <dbl> 0.06, 0.48, 0.39, 0.57, 0.55, 0.64, 0.58, 0.57, 0.56, 0.57, 0....
$ Ca <dbl> 8.75, 7.83, 7.78, 8.22, 8.07, 8.07, 8.17, 8.24, 8.30, 8.40, 8....
$ Ba <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,...
$ Fe <dbl> 0.00, 0.00, 0.00, 0.00, 0.00, 0.26, 0.00, 0.00, 0.00, 0.11, 0....
$ Tipo <fct> X1, X1, X1, X1, X1, X1, X1, X1, X1, X1, X1, X1, X1, X1, X1, X1...
Com o ajuste inicial do nosso df, foi modificado a classe das variáveis nos objetos e ajustado os fatores / classes / labels / rótulos dos vidros, sendo estes renomeadas para \({X1,\;X2,\;X3,\;X5, X6\;e\;X7}\), para posterior uso na construção de modelo preditivo.
Agora vamos analisar se há NA ou NaN nos nossos dados, e, vamos aproveitar para calcular as estatísticas de tendência central e realizar de modo simultâneo um histograma de nossas variáveis de interesse.
Abaixo, utilizaremos as abas Análise 1 e Análise 2 para expor nossas informações descritas até aqui. Sendo que a aba Análise 2, servirá para nos aprofundarmos na análise descritiva com as variáveis de interesse de acordo com o label.
Análise 1.1
df %>%
dplyr::select(-c("Tipo")) %>%
skimr::skim() %>%
dplyr::rename("Tipo da Variável" = skim_type, "Variável" = skim_variable, "nº NA" = n_missing,
"Média" = numeric.mean, "DP" = numeric.sd,
"p0" = numeric.p0, "p25" = numeric.p25, "p50" = numeric.p50,
"p75" = numeric.p75,"p100" = numeric.p100,
"Histograma" = numeric.hist) %>%
dplyr::select(-c("complete_rate")) %>%
knitr::kable()| Tipo da Variável | Variável | nº NA | Média | DP | p0 | p25 | p50 | p75 | p100 | Histograma |
|---|---|---|---|---|---|---|---|---|---|---|
| numeric | RI | 0 | 1.3759749 | 0.4219572 | 0.01518 | 1.51618 | 1.51755 | 1.519033 | 1.53393 | ▁▁▁▁▇ |
| numeric | Na | 0 | 13.4078505 | 0.8166036 | 10.73000 | 12.90750 | 13.30000 | 13.825000 | 17.38000 | ▁▇▆▁▁ |
| numeric | Mg | 0 | 2.6845327 | 1.4424078 | 0.00000 | 2.11500 | 3.48000 | 3.600000 | 4.49000 | ▃▁▁▇▅ |
| numeric | Al | 0 | 1.4449065 | 0.4992696 | 0.29000 | 1.19000 | 1.36000 | 1.630000 | 3.50000 | ▂▇▃▁▁ |
| numeric | Si | 0 | 72.6509346 | 0.7745458 | 69.81000 | 72.28000 | 72.79000 | 73.087500 | 75.41000 | ▁▂▇▂▁ |
| numeric | K | 0 | 0.4970561 | 0.6521918 | 0.00000 | 0.12250 | 0.55500 | 0.610000 | 6.21000 | ▇▁▁▁▁ |
| numeric | Ca | 0 | 8.9569626 | 1.4231535 | 5.43000 | 8.24000 | 8.60000 | 9.172500 | 16.19000 | ▁▇▁▁▁ |
| numeric | Ba | 0 | 0.1750467 | 0.4972193 | 0.00000 | 0.00000 | 0.00000 | 0.000000 | 3.15000 | ▇▁▁▁▁ |
| numeric | Fe | 0 | 0.0570093 | 0.0974387 | 0.00000 | 0.00000 | 0.00000 | 0.100000 | 0.51000 | ▇▁▁▁▁ |
plotx <- df %>%
dplyr::mutate_at(1:9, funs(scale)) %>%
tidyr::gather("Var", "Valor",-Tipo) %>%
ggplot2::ggplot() +
geom_jitter(aes(x = Var, y = Valor, col = Tipo), alpha = 0.6, width = 0.15) +
guides(colour = guide_legend(override.aes = list(size = 5))) +
xlab("Variáveis") +
ylab("z-score") +
theme_bw() +
tema +
theme(legend.position = "bottom")
plotx1 <- df %>%
dplyr::mutate_at(1:9, funs(scale)) %>%
tidyr::gather("Var", "Valor",-Tipo) %>%
ggplot2::ggplot() +
geom_boxplot(aes(x = Var, y = Valor),
alpha = 0.9, show.legend = F, width = 0.4) +
xlab("Variáveis") +
ylab("z-score") +
theme_bw() +
tema
plotx8 <- cowplot::plot_grid(plotx, plotx1, align = "hv", axis = "bt", labels = c("(A)", "(B)"))
ggsave(file = "plotx8.png", plotx8, width = 13, height = 9, dpi = 700)
plotx8Análise 1.2
# df %>%
# dplyr::filter(Tipo == "X6") %>%
# dplyr::select(Fe, Ba)
df %>%
dplyr::group_by(Tipo) %>%
skimr::skim() %>%
dplyr::rename("Variável" = skim_variable, "Classe" = Tipo,
"Média" = numeric.mean, "DP" = numeric.sd,
"p0" = numeric.p0, "p25" = numeric.p25, "p50" = numeric.p50,
"p75" = numeric.p75,"p100" = numeric.p100,
"Histograma" = numeric.hist) %>%
dplyr::select(-c("skim_type", "complete_rate", "n_missing")) %>%
knitr::kable()| Variável | Classe | Média | DP | p0 | p25 | p50 | p75 | p100 | Histograma |
|---|---|---|---|---|---|---|---|---|---|
| RI | X1 | 1.3975243 | 0.3986370 | 0.01519 | 1.517473 | 1.51772 | 1.519105 | 1.52667 | ▁▁▁▁▇ |
| RI | X2 | 1.3011288 | 0.5061894 | 0.01518 | 1.515937 | 1.51674 | 1.518445 | 1.53393 | ▂▁▁▁▇ |
| RI | X3 | 1.2771394 | 0.5370472 | 0.15161 | 1.516460 | 1.51769 | 1.518320 | 1.52211 | ▂▁▁▁▇ |
| RI | X5 | 1.5189277 | 0.0033454 | 1.51316 | 1.516660 | 1.51994 | 1.521190 | 1.52369 | ▃▁▁▇▂ |
| RI | X6 | 1.5174556 | 0.0031158 | 1.51115 | 1.518290 | 1.51888 | 1.519160 | 1.51969 | ▁▁▁▁▇ |
| RI | X7 | 1.4700555 | 0.2535801 | 0.15164 | 1.516020 | 1.51651 | 1.517270 | 1.52365 | ▁▁▁▁▇ |
| Na | X1 | 13.2422857 | 0.4993015 | 12.45000 | 12.825000 | 13.19500 | 13.525000 | 14.77000 | ▇▇▅▂▁ |
| Na | X2 | 13.1117105 | 0.6641594 | 10.73000 | 12.885000 | 13.15500 | 13.432500 | 14.86000 | ▁▁▇▇▁ |
| Na | X3 | 13.4370588 | 0.5068871 | 12.16000 | 13.240000 | 13.42000 | 13.640000 | 14.32000 | ▁▁▇▆▃ |
| Na | X5 | 12.8276923 | 0.7770366 | 11.03000 | 12.730000 | 12.97000 | 13.270000 | 14.01000 | ▂▁▂▇▂ |
| Na | X6 | 14.6466667 | 1.0840203 | 13.79000 | 14.090000 | 14.40000 | 14.560000 | 17.38000 | ▇▂▁▁▁ |
| Na | X7 | 14.4420690 | 0.6863588 | 11.95000 | 14.200000 | 14.39000 | 14.860000 | 15.79000 | ▁▁▃▇▁ |
| Mg | X1 | 3.5524286 | 0.2470430 | 2.71000 | 3.480000 | 3.56500 | 3.657500 | 4.49000 | ▁▁▇▁▁ |
| Mg | X2 | 3.0021053 | 1.2156615 | 0.00000 | 3.057500 | 3.52000 | 3.622500 | 3.98000 | ▁▁▁▁▇ |
| Mg | X3 | 3.5435294 | 0.1627859 | 3.34000 | 3.400000 | 3.53000 | 3.650000 | 3.90000 | ▇▃▅▂▁ |
| Mg | X5 | 0.7738462 | 0.9991458 | 0.00000 | 0.000000 | 0.00000 | 1.710000 | 2.68000 | ▇▁▁▃▁ |
| Mg | X6 | 1.3055556 | 1.0971339 | 0.00000 | 0.000000 | 1.74000 | 2.240000 | 2.41000 | ▆▂▁▂▇ |
| Mg | X7 | 0.5382759 | 1.1176828 | 0.00000 | 0.000000 | 0.00000 | 0.000000 | 3.34000 | ▇▁▁▁▁ |
| Al | X1 | 1.1638571 | 0.2731581 | 0.29000 | 1.112500 | 1.23000 | 1.327500 | 1.69000 | ▁▁▂▇▁ |
| Al | X2 | 1.4081579 | 0.3183403 | 0.56000 | 1.247500 | 1.46000 | 1.570000 | 2.12000 | ▂▃▇▆▂ |
| Al | X3 | 1.2011765 | 0.3474889 | 0.58000 | 0.910000 | 1.28000 | 1.380000 | 1.76000 | ▅▃▆▇▅ |
| Al | X5 | 2.0338462 | 0.6939205 | 1.40000 | 1.560000 | 1.76000 | 2.170000 | 3.50000 | ▇▃▁▂▁ |
| Al | X6 | 1.3666667 | 0.5718610 | 0.34000 | 1.190000 | 1.56000 | 1.660000 | 2.09000 | ▃▁▂▇▂ |
| Al | X7 | 2.1227586 | 0.4427261 | 1.19000 | 1.870000 | 2.06000 | 2.420000 | 2.88000 | ▂▃▇▇▅ |
| Si | X1 | 72.6191429 | 0.5694842 | 71.35000 | 72.080000 | 72.81500 | 73.017500 | 73.70000 | ▃▃▃▇▂ |
| Si | X2 | 72.5980263 | 0.7245726 | 69.81000 | 72.330000 | 72.73500 | 73.062500 | 74.45000 | ▁▁▆▇▁ |
| Si | X3 | 72.4047059 | 0.5122758 | 71.36000 | 72.040000 | 72.64000 | 72.700000 | 73.01000 | ▂▂▂▇▇ |
| Si | X5 | 72.3661538 | 1.2823191 | 69.89000 | 72.180000 | 72.69000 | 73.390000 | 73.88000 | ▃▂▆▆▇ |
| Si | X6 | 73.2066667 | 1.0794675 | 72.37000 | 72.500000 | 72.74000 | 73.480000 | 75.41000 | ▇▁▁▁▁ |
| Si | X7 | 72.9658621 | 0.9402337 | 70.26000 | 72.860000 | 73.11000 | 73.360000 | 75.18000 | ▁▁▇▇▁ |
| K | X1 | 0.4474286 | 0.2148790 | 0.00000 | 0.200000 | 0.56000 | 0.590000 | 0.69000 | ▂▂▁▂▇ |
| K | X2 | 0.5210526 | 0.2137262 | 0.00000 | 0.480000 | 0.58000 | 0.650000 | 1.10000 | ▂▁▇▂▁ |
| K | X3 | 0.4064706 | 0.2298897 | 0.00000 | 0.160000 | 0.56000 | 0.570000 | 0.61000 | ▃▂▁▁▇ |
| K | X5 | 1.4700000 | 2.1386951 | 0.13000 | 0.380000 | 0.58000 | 0.970000 | 6.21000 | ▇▁▁▁▂ |
| K | X6 | 0.0000000 | 0.0000000 | 0.00000 | 0.000000 | 0.00000 | 0.000000 | 0.00000 | ▁▁▇▁▁ |
| K | X7 | 0.3251724 | 0.6684931 | 0.00000 | 0.000000 | 0.00000 | 0.140000 | 2.70000 | ▇▁▁▁▁ |
| Ca | X1 | 8.7972857 | 0.5748066 | 7.78000 | 8.430000 | 8.67500 | 9.052500 | 10.17000 | ▃▇▅▂▂ |
| Ca | X2 | 9.0736842 | 1.9216353 | 7.08000 | 8.037500 | 8.27500 | 8.915000 | 16.19000 | ▇▁▁▁▁ |
| Ca | X3 | 8.7829412 | 0.3801112 | 8.32000 | 8.530000 | 8.79000 | 8.930000 | 9.65000 | ▇▇▃▁▂ |
| Ca | X5 | 10.1238462 | 2.1837908 | 5.87000 | 9.700000 | 11.27000 | 11.530000 | 12.50000 | ▃▁▁▂▇ |
| Ca | X6 | 9.3566667 | 1.4499483 | 6.65000 | 9.260000 | 9.57000 | 9.950000 | 11.22000 | ▂▂▅▇▅ |
| Ca | X7 | 8.4913793 | 0.9735052 | 5.43000 | 8.440000 | 8.67000 | 8.950000 | 9.76000 | ▁▁▁▇▅ |
| Ba | X1 | 0.0127143 | 0.0838377 | 0.00000 | 0.000000 | 0.00000 | 0.000000 | 0.69000 | ▇▁▁▁▁ |
| Ba | X2 | 0.0502632 | 0.3623404 | 0.00000 | 0.000000 | 0.00000 | 0.000000 | 3.15000 | ▇▁▁▁▁ |
| Ba | X3 | 0.0088235 | 0.0363803 | 0.00000 | 0.000000 | 0.00000 | 0.000000 | 0.15000 | ▇▁▁▁▁ |
| Ba | X5 | 0.1876923 | 0.6082510 | 0.00000 | 0.000000 | 0.00000 | 0.000000 | 2.20000 | ▇▁▁▁▁ |
| Ba | X6 | 0.0000000 | 0.0000000 | 0.00000 | 0.000000 | 0.00000 | 0.000000 | 0.00000 | ▁▁▇▁▁ |
| Ba | X7 | 1.0400000 | 0.6653409 | 0.00000 | 0.610000 | 0.81000 | 1.590000 | 2.88000 | ▅▆▇▁▁ |
| Fe | X1 | 0.0570000 | 0.0890750 | 0.00000 | 0.000000 | 0.00000 | 0.110000 | 0.31000 | ▇▂▁▁▁ |
| Fe | X2 | 0.0797368 | 0.1064327 | 0.00000 | 0.000000 | 0.00000 | 0.155000 | 0.35000 | ▇▂▂▁▁ |
| Fe | X3 | 0.0570588 | 0.1078636 | 0.00000 | 0.000000 | 0.00000 | 0.090000 | 0.37000 | ▇▁▁▁▁ |
| Fe | X5 | 0.0607692 | 0.1555882 | 0.00000 | 0.000000 | 0.00000 | 0.000000 | 0.51000 | ▇▁▁▁▁ |
| Fe | X6 | 0.0000000 | 0.0000000 | 0.00000 | 0.000000 | 0.00000 | 0.000000 | 0.00000 | ▁▁▇▁▁ |
| Fe | X7 | 0.0134483 | 0.0297940 | 0.00000 | 0.000000 | 0.00000 | 0.000000 | 0.09000 | ▇▁▁▁▁ |
Como pode-se perceber não temos NA ou NaN no nosso df. Logo, não temos a necessidade de inputar dados faltantes.
Nossas variáveis não apresentam distribuições claramente semelhantes. Do ponto de vista descritivo, comparando classes numa mesma variável, a classe X3 apresenta menor valor médio de RI, e X5 e X6 apresentam os maiores valores. E, de modo inverso, X5 e X6 apresentam os menores valores de desvio padrão (DP), e X3 apresenta o maior valor.
Da variável Na os maiores valores de média e DP são referentes a X6, e para X1 e X3 os valores de média e DP estão próximos. Os valores de DP de X1 e X3 para Mg, estão muito abaixo que para as outras classes, e os valores de média estão próximos.
X1 e X2 apresentam baixos valores de DP em Al. Em K, X6 apresenta média e DP iguais a zero, e X5 apresenta elevado DP. Em Ca, as médias de X1 e X3 são muito próximas, e ambas as classes tem baixo valor de DP. E, para Ba e Fe, a média e o DP de X6 são iguais a zero.
Contudo é interessante frisar a semelhança entre os dados das classes X1 e X3, apresentando uma leve divergência apenas para RI e Ba.
plotx <- df %>%
GGally::ggpairs(columns = 1:9,
mapping = aes(color = Tipo, alpha = 0.5),
upper = list(continuous = wrap("cor", size = 2)),
lower = list(continuous = wrap("points", alpha = 0.3)))
shiny::div(plotly::ggplotly(plotx), align = "center")plotx <- df %>%
dplyr::filter(Tipo %in% c("X1", "X3")) %>%
GGally::ggpairs(columns = 1:9,
mapping = aes(color = Tipo, alpha = 0.5),
upper = list(continuous = wrap("cor", size = 2.5)),
lower = list(continuous = wrap("points", alpha = 0.3)))
shiny::div(plotly::ggplotly(plotx), align = "center")
Aparentemente não é possível visualizar um padrão claro entre as classes, e através da nossa matriz de dispersão, não conseguimos identificar situação de colinearidade entre as variáveis.
A homogeneidade entre os objetos pode, desde já, nos nortear quanto a dificuldade de construção de modelo preditivo com bons valores de sensibilidade e especificidade. E se focarmos nos grupos X1 e X3, que é este, que desde a estatística básica apresenta homogeneidade, poderemos notar o quão similares os grupos são.
Verificando Especificidades em X1 e X3
Os conjuntos de objetos pertencentes a X1 e X3 apresentam comportamento muito semelhante, e, em algum casos, com apresentando comportamento similar a uma situação bimodal, e para essas, realizaremos nosso ggpairs de formas separadas, dada as devidas condições anunciadas nas abas, e também utilizaremos o recurso de representação em 3D, a fim de tentar melhorar a perspectiva visual.
RI > 1
plotx <- df %>%
dplyr::filter(Tipo %in% c("X1", "X3"),
RI > 1) %>%
GGally::ggpairs(columns = 1:9,
mapping = aes(color = Tipo, alpha = 0.5),
upper = list(continuous = wrap("cor", size = 2.5)),
lower = list(continuous = wrap("points", alpha = 0.3)))
shiny::div(plotly::ggplotly(plotx), align = "center")RI < 1
plotx <- df %>%
dplyr::filter(Tipo %in% c("X1", "X3"),
RI < 1) %>%
GGally::ggpairs(columns = 1:9,
mapping = aes(color = Tipo, alpha = 0.5),
upper = list(continuous = wrap("cor", size = 2.5)),
lower = list(continuous = wrap("points", alpha = 0.3)))
shiny::div(plotly::ggplotly(plotx), align = "center")K > 0.4
plotx <- df %>%
dplyr::filter(Tipo %in% c("X1", "X3"),
K > 0.4) %>%
GGally::ggpairs(columns = 1:9,
mapping = aes(color = Tipo, alpha = 0.5),
upper = list(continuous = wrap("cor", size = 2.5)),
lower = list(continuous = wrap("points", alpha = 0.3)))
shiny::div(plotly::ggplotly(plotx), align = "center")K < 0.4
plotx <- df %>%
dplyr::filter(Tipo %in% c("X1", "X3"),
K < 0.4) %>%
GGally::ggpairs(columns = 1:9,
mapping = aes(color = Tipo, alpha = 0.5),
upper = list(continuous = wrap("cor", size = 2.5)),
lower = list(continuous = wrap("points", alpha = 0.3)))
shiny::div(plotly::ggplotly(plotx), align = "center")Ca versus Mg, Na
plot_b <- df %>%
dplyr::filter(Tipo %in% c("X1", "X3"),
K < 0.4) %>%
ggplot2::ggplot() +
geom_point(aes(x = Ca, y = Na, col = Tipo), size = 7, alpha = 0.5) +
theme_bw() +
tema +
theme(legend.position = "bottom")
plot_b1 <- df %>%
dplyr::filter(Tipo %in% c("X1", "X3"),
K < 0.4) %>%
ggplot2::ggplot() +
geom_point(aes(x = Ca, y = Mg, col = Tipo), size = 7, alpha = 0.5) +
theme_bw() +
tema +
theme(legend.position = "bottom")
plotb <- cowplot::plot_grid(plot_b, plot_b1, align = "hv")
ggsave(file = "plotb.png", plotb, width = 11, height = 7, dpi = 700)
plotb3D
plot1 <- df %>%
dplyr::filter(Tipo %in% c("X1", "X3")) %>%
ggplot(aes(x = Fe, y = RI, z = K,
color = Tipo)) +
theme_void() +
theme(plot.background = element_rect(color = "black")) +
axes_3D(theta = 0) +
stat_3D(theta = 0)
plot2 <- df %>%
dplyr::filter(Tipo %in% c("X1", "X3")) %>%
ggplot(aes(x = Fe, y = RI, z = K,
color = Tipo)) +
theme_void() +
theme(plot.background = element_rect(color = "black")) +
axes_3D(theta = 90) +
stat_3D(theta = 90)
plot3 <- df %>%
dplyr::filter(Tipo %in% c("X1", "X3")) %>%
ggplot(aes(x = Fe, y = RI, z = K,
color = Tipo)) +
theme_void() +
theme(plot.background = element_rect(color = "black")) +
axes_3D(theta = 180) +
stat_3D(theta = 180)
plot4 <- df %>%
dplyr::filter(Tipo %in% c("X1", "X3")) %>%
ggplot(aes(x = Fe, y = RI, z = K,
color = Tipo)) +
theme_void() +
theme(plot.background = element_rect(color = "black")) +
axes_3D(theta = 270) +
stat_3D(theta = 270)
plotx7 <- cowplot::plot_grid(plot1, plot2, plot3, plot4, align = "hv",
labels = c('0°', '90°', '180°', '270°'))
ggsave(file = "plotx7.png", plotx7, width = 13, height = 9, dpi = 700)
plotx7#### 3D interactive
cores <- c("royalblue1", "darkcyan", "green1", "black", "goldenrod3", "red2")
df %>%
plotly::plot_ly(x = ~RI, y = ~Ca, z = ~Fe, color = ~Tipo,
colors = cores, opacity = 0.4, stroke = "black") %>%
add_markers() %>%
layout(scene = list(xaxis = list(title = 'RI'),
yaxis = list(title = 'Ca'),
zaxis = list(title = 'Fe')))df %>%
plotly::plot_ly(x = ~Al, y = ~Mg, z = ~Fe, color = ~Tipo,
colors = cores, opacity = 0.4, stroke = "black") %>%
add_markers() %>%
layout(scene = list(xaxis = list(title = 'Al'),
yaxis = list(title = 'Mg'),
zaxis = list(title = 'Fe')))3D interactive para X1 e X3
Através da análise visual dos gráficos de dispersão é notável que alguns pontos mais distantes da massa de dados. E, apesar do problema em análise abordar variáveis com baixa incerteza de medição e elucidarem grandezas físico-química, realizaremos análise visual para discriminação de potenciais valores aberrantes (outliers).
Tal fato será importante, também, para tentar minimizar o possível bias gerado futuramento no modelo preditor, pois, é nítido que as classes (labels) estão desbalanceados, como pode ser visualizado abaixo, onde, de 214 objetos, apenas 4.21% representam a classe X6.
Contudo, a priori, procederemos com cautela pois X3 e X5 também apresentam baixos percentuais de representação no conjunto de objetos em análise, como pode ser visualizado no chunk abaixo. E, no próximo tópico, tentaremos refinar o nosso df identificando possíveis outliers.
X1 X2 X3 X5 X6 X7
70 76 17 13 9 29
Outliers
Para iniciar o processo de identificação de possíveis outliers, criaremos uma coluna de ID no nosso df para poder facilitar o processo de manipulação de dados.
Novamente, com o auxílio do gráfico de dispersão, iniciaremos a prospecção dos possíveis objetos enquadrados como outliers. E, utilizaremos a ferramenta de gráfico interativo para poder identificar as informações de variáveis e de ID.
df_out <- df %>%
tibble::rowid_to_column()
plotx6 <- df_out %>%
GGally::ggpairs(columns = 2:10,
mapping = aes(color = Tipo, alpha = 0.5, ),
upper = list(continuous = wrap("cor", size = 2.5)),
lower = list(continuous = wrap("points", alpha = 0.3)))
ggsave(file = "plotx6.png", plotx6, width = 13, height = 9, dpi = 700)
shiny::div(plotly::ggplotly(plotx6),
align = "center")
Foi notado que os objetos \(107,\;108,\;164,\;173\;e\;175\) estão muito afastados da massa central de dados. Como pode ser evidenciado abaixo. Sendo \(107\;e\;108\) pertencentes a classe X2 e \(164,\;173\;e\;175\) a classe X5.
A fim de tornar ainda mais evidente a informação, apresentaremos os gráficos de dispersão em maior tamanho e em escala z-score.
df_out2 <- df_out %>%
dplyr::mutate(rowid = as.factor(rowid),
Out = ifelse(rowid == "107" | rowid == "108" | rowid == "164" |
rowid == "173" | rowid == "175", "out", "ok")) %>%
dplyr::mutate_at(vars(2:10), funs(scale)) %>% # scale()
tidyr::gather(key = "Variaveis", value = "valor", 2:10)
plotx5 <- df_out2 %>%
dplyr::mutate(rowid = as.numeric(as.character(rowid))) %>%
ggplot2::ggplot() +
ggplot2::geom_jitter(aes(x = Variaveis, y = valor, fill = Out,
shape = Out),
alpha = 0.5, size = 3,
show.legend = F) +
facet_wrap(~Tipo, scales = "free") +
scale_shape_manual(values = c(20, 21)) +
theme_bw()
ggsave(file = "plotx5.png", plotx5, width = 13, height = 9, dpi = 700)
shiny::div(plotly::ggplotly(plotx5),
align = "center")df_out2xx <- df_out2 %>%
dplyr::mutate(Out = as.factor(Out))
levels(df_out2xx$Out) <- c('"Normal"', '"Outlier"')
plotx4 <- df_out2xx %>%
dplyr::filter(Variaveis == "Na") %>%
ggplot2::ggplot() +
stat_boxplot(aes(x = Tipo, y = valor),
geom = "errorbar", width = 0.5) +
geom_boxplot(aes(x = Tipo, y = valor),
color = "black", show.legend = F, outlier.shape = NA) +
geom_point(aes(x = Tipo, y = valor,
shape = Out, fill = Out, alpha = Out),
size = 5, width = 0.2,
position = position_jitter(w = 0.1, h = 0)) +
scale_shape_manual(values = c(24, 21)) +
scale_alpha_manual(values = c(0.2, 0.7)) +
scale_y_continuous(limits = c(min(df_out2$valor), max(df_out2$valor))) +
xlab(label = "Tipo do Vidro") + ylab("Z-Score") +
theme_bw() +
tema + theme(legend.position = "bottom")
plotx4ggsave(file = "plotx4.png", plotx4, width = 11, height = 7, dpi = 700)
shiny::div(plotly::ggplotly(plotx4),
align = "center")
Contudo, ao plotar os pontos e box-plot em função da variável Na, podemos notar que os objetos \(173\;e\;175\) não apresentam comportamento incomum ou valor aberrante para o parâmetro, logo, manteremos como outliers apenas os objetos \(107,\;108\;e\;164\).
CONSTRUINDO MODELOS PREDITIVOS PARA CLASSIFICAÇÃO DE VIDRO
No presente trabalho utilizaremos o algoritmo de Random Forest, através do pacote caret, para poder proceder com a classificação multiclasse dos vidros. Adotaremos um número padrão de árvores (ntree = 1500), e todos os modelos gerados serão “cross-validados” através da técnica k-fold, onde \(k=10\). Como nesse problema existe desbalanceamento de classes, utilizaremos também técnicas de compensação como undersampling e oversampling.
Deste modo, utilizando o conjunto de dados sem promover modificações (apenas removendo outliers), construiremos 03 modelos de classificação:
Modelo com dados originais;
Modelo com under;
Modelo com over.
Logo, para proceder com a construção dos nossos modelos de classificação, manipularemos os dados para removermos os outliers, separaremos nosso banco de dados em treino (train_data) e teste (test_data), na proporção de 70-30%, e criaremos o objeto control_Cv para poder proceder com a cross-validation.
df_pred <- df_out %>%
dplyr::filter(!rowid %in% c("107","108","164")) %>%
dplyr::select(-rowid)
df_pred_tst <- df_pred
{
set.seed(42)
index <- caret::createDataPartition(df_pred$Tipo, p = 0.7, list = FALSE) # particao
train_data <- df_pred[index, ]
test_data <- df_pred[-index, ]
control_Cv_orig <- caret::trainControl(method = "cv", # cross-validation
number = 10,
classProbs = T,
savePredictions = T,
verboseIter = FALSE)
control_Cv_up <- caret::trainControl(method = "cv", # cross-validation
number = 10,
classProbs = T,
savePredictions = T,
verboseIter = FALSE,
sampling = "up")
control_Cv_down <- caret::trainControl(method = "cv", # cross-validation
number = 10,
classProbs = T,
savePredictions = T,
verboseIter = FALSE,
sampling = "down")
}
arvores <- 1500
Com o df devidamente ajustado, partiremos então para a construção dos modelos:
MODELO RF SEM REAMOSTRAGEM
- Random Forest sem reamostragem (original)
set.seed(42)
model_rf_m1 <- caret::train(Tipo ~ .,
data = train_data,
method = "rf",
ntree = arvores,
preProcess = c("scale", "center"),
trControl = control_Cv_orig)
cm_original_m1 <- caret::confusionMatrix(predict(model_rf_m1, test_data),
test_data$Tipo)
cm_original_m1Confusion Matrix and Statistics
Reference
Prediction X1 X2 X3 X5 X6 X7
X1 17 4 4 0 0 1
X2 3 18 0 0 0 0
X3 1 0 1 0 0 0
X5 0 0 0 3 0 0
X6 0 0 0 0 2 2
X7 0 0 0 0 0 5
Overall Statistics
Accuracy : 0.7541
95% CI : (0.6271, 0.8554)
No Information Rate : 0.3607
P-Value [Acc > NIR] : 4.418e-10
Kappa : 0.6542
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: X1 Class: X2 Class: X3 Class: X5 Class: X6
Sensitivity 0.8095 0.8182 0.20000 1.00000 1.00000
Specificity 0.7750 0.9231 0.98214 1.00000 0.96610
Pos Pred Value 0.6538 0.8571 0.50000 1.00000 0.50000
Neg Pred Value 0.8857 0.9000 0.93220 1.00000 1.00000
Prevalence 0.3443 0.3607 0.08197 0.04918 0.03279
Detection Rate 0.2787 0.2951 0.01639 0.04918 0.03279
Detection Prevalence 0.4262 0.3443 0.03279 0.04918 0.06557
Balanced Accuracy 0.7923 0.8706 0.59107 1.00000 0.98305
Class: X7
Sensitivity 0.62500
Specificity 1.00000
Pos Pred Value 1.00000
Neg Pred Value 0.94643
Prevalence 0.13115
Detection Rate 0.08197
Detection Prevalence 0.08197
Balanced Accuracy 0.81250
MODELO RF COM OVERSAMPLING
- Random Forest com oversampling
set.seed(42)
model_rf_up_m1 <- caret::train(Tipo ~ .,
data = train_data,
method = "rf",
ntree = arvores,
preProcess = c("scale", "center"),
trControl = control_Cv_up)
cm_over_m1 <- caret::confusionMatrix(predict(model_rf_up_m1, test_data),
test_data$Tipo)
cm_over_m1Confusion Matrix and Statistics
Reference
Prediction X1 X2 X3 X5 X6 X7
X1 18 4 3 0 0 1
X2 3 18 0 0 0 1
X3 0 0 2 0 0 0
X5 0 0 0 3 0 0
X6 0 0 0 0 2 0
X7 0 0 0 0 0 6
Overall Statistics
Accuracy : 0.8033
95% CI : (0.6816, 0.894)
No Information Rate : 0.3607
P-Value [Acc > NIR] : 1.86e-12
Kappa : 0.7206
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: X1 Class: X2 Class: X3 Class: X5 Class: X6
Sensitivity 0.8571 0.8182 0.40000 1.00000 1.00000
Specificity 0.8000 0.8974 1.00000 1.00000 1.00000
Pos Pred Value 0.6923 0.8182 1.00000 1.00000 1.00000
Neg Pred Value 0.9143 0.8974 0.94915 1.00000 1.00000
Prevalence 0.3443 0.3607 0.08197 0.04918 0.03279
Detection Rate 0.2951 0.2951 0.03279 0.04918 0.03279
Detection Prevalence 0.4262 0.3607 0.03279 0.04918 0.03279
Balanced Accuracy 0.8286 0.8578 0.70000 1.00000 1.00000
Class: X7
Sensitivity 0.75000
Specificity 1.00000
Pos Pred Value 1.00000
Neg Pred Value 0.96364
Prevalence 0.13115
Detection Rate 0.09836
Detection Prevalence 0.09836
Balanced Accuracy 0.87500
MODELO RF COM UNDERSAMPLING
- Random Forest com undersampling
set.seed(42)
model_rf_down_m1 <- caret::train(Tipo ~ .,
data = train_data,
method = "rf",
ntree = arvores,
preProcess = c("scale", "center"),
trControl = control_Cv_down)
cm_down_m1 <- caret::confusionMatrix(predict(model_rf_down_m1, test_data),
test_data$Tipo)
cm_down_m1Confusion Matrix and Statistics
Reference
Prediction X1 X2 X3 X5 X6 X7
X1 13 4 1 0 0 0
X2 4 12 2 0 0 1
X3 4 4 2 0 0 0
X5 0 1 0 3 0 1
X6 0 0 0 0 2 0
X7 0 1 0 0 0 6
Overall Statistics
Accuracy : 0.623
95% CI : (0.4896, 0.7439)
No Information Rate : 0.3607
P-Value [Acc > NIR] : 2.787e-05
Kappa : 0.4989
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: X1 Class: X2 Class: X3 Class: X5 Class: X6
Sensitivity 0.6190 0.5455 0.40000 1.00000 1.00000
Specificity 0.8750 0.8205 0.85714 0.96552 1.00000
Pos Pred Value 0.7222 0.6316 0.20000 0.60000 1.00000
Neg Pred Value 0.8140 0.7619 0.94118 1.00000 1.00000
Prevalence 0.3443 0.3607 0.08197 0.04918 0.03279
Detection Rate 0.2131 0.1967 0.03279 0.04918 0.03279
Detection Prevalence 0.2951 0.3115 0.16393 0.08197 0.03279
Balanced Accuracy 0.7470 0.6830 0.62857 0.98276 1.00000
Class: X7
Sensitivity 0.75000
Specificity 0.98113
Pos Pred Value 0.85714
Neg Pred Value 0.96296
Prevalence 0.13115
Detection Rate 0.09836
Detection Prevalence 0.11475
Balanced Accuracy 0.86557
TRANSFORMANDO DADOS
Apesar da robustez do algoritmo de RF e dos resultados satisfatórios removendo alguns objetos considerados como aberrantes, é notório que as distribuições de nossas variáveis preditoras K, Mg e RI apresentam elevada assimetria, e isto pode impactar negativamente o desempenho do modelo proposto.
Deste modo, iremos proceder com manutenção dos objetos considerados inicialmente como outliers e realizaremos a transformação das variáveis supracitadas através da técnica de transoformação de Yeo–Johnson. Tal fato se dá pela homogeneização da escolha do método de transformação pois algumas de nosss variáveis apresentam valor igual a 0 (zero), logo não poderemos utiliar técnica como transformação Box-Cox para todas as variáveis.
Abaixo, podemos visualizar que as variáveis mencionadas não apresentam visualmente padrão de distribuição normal.
shiny::div(plotly::ggplotly(df %>%
dplyr::select(RI, K, Mg, Tipo) %>%
tidyr::gather(key = "Variavel",
value = "valor", c(RI, K, Mg)) %>%
ggplot2::ggplot() +
geom_density(aes(valor, fill = Tipo), alpha = 0.5) +
facet_wrap(~Variavel, scales = "free") +
ylab("Densidade") +
theme_minimal_hgrid(12),
align = "center"))shiny::div(plotly::ggplotly(df %>%
dplyr::select(RI, K, Mg) %>%
tidyr::gather(key = "Variavel", value = "valor") %>%
ggplot2::ggplot() +
geom_density(aes(valor, fill = Variavel), alpha = 0.5) +
facet_wrap(~Variavel, scales = "free") +
ylab("Densidade") +
theme_minimal_hgrid(12),
align = "center"))CONSTRUINDO NOVOS MODELOS
Apesar dos bons valores de Acurácia, a classe X3 não apresenta bom score de Verdaadeiros Positivos, logo, novos modelos serão propostos para cenários similares, tendo em vista o melhor ajuste para o modelo preditor.
Cenário A
Para construir os novos modelos, precisaremos reajustar nosso df.
df_pred2 <- df %>%
dplyr::mutate(RI_tr = car::yjPower(df$RI, BN_RI$other_transforms$yeojohnson$lambda),
K_tr = car::yjPower(df$K, BN_K$other_transforms$yeojohnson$lambda),
Mg_tr = car::yjPower(df$Mg, BN_Mg$other_transforms$yeojohnson$lambda)) %>%
dplyr::select(-c(RI, K, Mg))
Para poder incrementar performance aos modelos propostos criaremos uma relação não linear entre os preditores e a resposta executando a regressão usando transformações dos preditores (James et al., 2013), onde iremos incluir variáveis \(X^2\) no nosso modelo.
E, para implementar tal estratéfia, as variáveis Fe e Ca serão elevadas a potência 2, baseado na análise exploratória e o feedback dos modelos construídos no moemnto anterior.
Poderiamos pensar em algo similar para a variável Ba, contudo, a explicação para semelhança de medidas de tendência central em X1 e X3 para Ba se dá pela elevada quantidade de objetos com valor 0 (zero) para esta variável preditora.
Nossos novos modelos propostos terão configuração análoga ao primeiros modelos, com dados “originais”, undersampling e oversampling.
{
set.seed(42)
index <- caret::createDataPartition(df_pred2$Tipo, p = 0.7, list = FALSE) # particao
train_data <- df_pred2[index, ]
test_data <- df_pred2[-index, ]
}- Random Forest sem reamostragem (original)
set.seed(42)
model_rf_m2aori <- caret::train(Tipo ~ .,
data = train_data,
method = "rf",
ntree = arvores,
preProcess = c("scale", "center"),
trControl = control_Cv_orig)
cm_original_m2aori <- caret::confusionMatrix(predict(model_rf_m2aori, test_data),
test_data$Tipo)
cm_original_m2aoriConfusion Matrix and Statistics
Reference
Prediction X1 X2 X3 X5 X6 X7
X1 17 3 4 0 0 1
X2 4 19 0 0 0 0
X3 0 0 1 0 0 0
X5 0 0 0 3 0 0
X6 0 0 0 0 2 1
X7 0 0 0 0 0 6
Overall Statistics
Accuracy : 0.7869
95% CI : (0.6632, 0.8814)
No Information Rate : 0.3607
P-Value [Acc > NIR] : 1.263e-11
Kappa : 0.6976
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: X1 Class: X2 Class: X3 Class: X5 Class: X6
Sensitivity 0.8095 0.8636 0.20000 1.00000 1.00000
Specificity 0.8000 0.8974 1.00000 1.00000 0.98305
Pos Pred Value 0.6800 0.8261 1.00000 1.00000 0.66667
Neg Pred Value 0.8889 0.9211 0.93333 1.00000 1.00000
Prevalence 0.3443 0.3607 0.08197 0.04918 0.03279
Detection Rate 0.2787 0.3115 0.01639 0.04918 0.03279
Detection Prevalence 0.4098 0.3770 0.01639 0.04918 0.04918
Balanced Accuracy 0.8048 0.8805 0.60000 1.00000 0.99153
Class: X7
Sensitivity 0.75000
Specificity 1.00000
Pos Pred Value 1.00000
Neg Pred Value 0.96364
Prevalence 0.13115
Detection Rate 0.09836
Detection Prevalence 0.09836
Balanced Accuracy 0.87500
- Random Forest com oversampling
set.seed(42)
model_rf_up_m2aup <- caret::train(Tipo ~ .,
data = train_data,
method = "rf",
ntree = arvores,
preProcess = c("scale", "center"),
trControl = control_Cv_up)
cm_over_m2aup <- caret::confusionMatrix(predict(model_rf_up_m2aup, test_data),
test_data$Tipo)
cm_over_m2aupConfusion Matrix and Statistics
Reference
Prediction X1 X2 X3 X5 X6 X7
X1 14 5 2 0 0 1
X2 5 17 2 1 1 0
X3 2 0 1 0 0 0
X5 0 0 0 2 0 1
X6 0 0 0 0 1 0
X7 0 0 0 0 0 6
Overall Statistics
Accuracy : 0.6721
95% CI : (0.54, 0.7869)
No Information Rate : 0.3607
P-Value [Acc > NIR] : 7.628e-07
Kappa : 0.5331
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: X1 Class: X2 Class: X3 Class: X5 Class: X6
Sensitivity 0.6667 0.7727 0.20000 0.66667 0.50000
Specificity 0.8000 0.7692 0.96429 0.98276 1.00000
Pos Pred Value 0.6364 0.6538 0.33333 0.66667 1.00000
Neg Pred Value 0.8205 0.8571 0.93103 0.98276 0.98333
Prevalence 0.3443 0.3607 0.08197 0.04918 0.03279
Detection Rate 0.2295 0.2787 0.01639 0.03279 0.01639
Detection Prevalence 0.3607 0.4262 0.04918 0.04918 0.01639
Balanced Accuracy 0.7333 0.7710 0.58214 0.82471 0.75000
Class: X7
Sensitivity 0.75000
Specificity 1.00000
Pos Pred Value 1.00000
Neg Pred Value 0.96364
Prevalence 0.13115
Detection Rate 0.09836
Detection Prevalence 0.09836
Balanced Accuracy 0.87500
- Random Forest com undersampling
set.seed(42)
model_rf_down_m2aunder <- caret::train(Tipo ~ .,
data = train_data,
method = "rf",
ntree = arvores,
preProcess = c("scale", "center"),
trControl = control_Cv_down)
cm_down_m2aunder <- caret::confusionMatrix(predict(model_rf_down_m2aunder, test_data),
test_data$Tipo)
cm_down_m2aunderConfusion Matrix and Statistics
Reference
Prediction X1 X2 X3 X5 X6 X7
X1 14 5 1 0 0 1
X2 2 12 2 0 0 0
X3 5 2 2 0 0 0
X5 0 2 0 3 0 0
X6 0 0 0 0 2 1
X7 0 1 0 0 0 6
Overall Statistics
Accuracy : 0.6393
95% CI : (0.5063, 0.7584)
No Information Rate : 0.3607
P-Value [Acc > NIR] : 8.991e-06
Kappa : 0.5217
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: X1 Class: X2 Class: X3 Class: X5 Class: X6
Sensitivity 0.6667 0.5455 0.40000 1.00000 1.00000
Specificity 0.8250 0.8974 0.87500 0.96552 0.98305
Pos Pred Value 0.6667 0.7500 0.22222 0.60000 0.66667
Neg Pred Value 0.8250 0.7778 0.94231 1.00000 1.00000
Prevalence 0.3443 0.3607 0.08197 0.04918 0.03279
Detection Rate 0.2295 0.1967 0.03279 0.04918 0.03279
Detection Prevalence 0.3443 0.2623 0.14754 0.08197 0.04918
Balanced Accuracy 0.7458 0.7214 0.63750 0.98276 0.99153
Class: X7
Sensitivity 0.75000
Specificity 0.98113
Pos Pred Value 0.85714
Neg Pred Value 0.96296
Prevalence 0.13115
Detection Rate 0.09836
Detection Prevalence 0.11475
Balanced Accuracy 0.86557
Cenário B
De maneira similar ao Cenário A, das “novas” variáveis, manteremos apenas a abordagem considerando as variáveis transformadas atráves do método Yeo-Johnson.
df_pred2 <- df %>%
dplyr::mutate(RI_tr = car::yjPower(df$RI, BN_RI$other_transforms$yeojohnson$lambda),
K_tr = car::yjPower(df$K, BN_K$other_transforms$yeojohnson$lambda),
Mg_tr = car::yjPower(df$Mg, BN_Mg$other_transforms$yeojohnson$lambda)) %>%
dplyr::select(-c(RI, K, Mg))
{
set.seed(42)
index <- caret::createDataPartition(df_pred2$Tipo, p = 0.7, list = FALSE) # particao
train_data <- df_pred2[index, ]
test_data <- df_pred2[-index, ]
}- Random Forest sem reamostragem (original)
set.seed(42)
model_rf_m2bori <- caret::train(Tipo ~ .,
data = train_data,
method = "rf",
tree = arvores,
preProcess = c("scale", "center"),
trControl = control_Cv_orig)
cm_original_m2bori <- caret::confusionMatrix(predict(model_rf_m2bori, test_data),
test_data$Tipo)
cm_original_m2boriConfusion Matrix and Statistics
Reference
Prediction X1 X2 X3 X5 X6 X7
X1 17 2 4 0 0 1
X2 4 20 0 0 0 1
X3 0 0 1 0 0 0
X5 0 0 0 3 0 0
X6 0 0 0 0 2 0
X7 0 0 0 0 0 6
Overall Statistics
Accuracy : 0.8033
95% CI : (0.6816, 0.894)
No Information Rate : 0.3607
P-Value [Acc > NIR] : 1.86e-12
Kappa : 0.7186
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: X1 Class: X2 Class: X3 Class: X5 Class: X6
Sensitivity 0.8095 0.9091 0.20000 1.00000 1.00000
Specificity 0.8250 0.8718 1.00000 1.00000 1.00000
Pos Pred Value 0.7083 0.8000 1.00000 1.00000 1.00000
Neg Pred Value 0.8919 0.9444 0.93333 1.00000 1.00000
Prevalence 0.3443 0.3607 0.08197 0.04918 0.03279
Detection Rate 0.2787 0.3279 0.01639 0.04918 0.03279
Detection Prevalence 0.3934 0.4098 0.01639 0.04918 0.03279
Balanced Accuracy 0.8173 0.8904 0.60000 1.00000 1.00000
Class: X7
Sensitivity 0.75000
Specificity 1.00000
Pos Pred Value 1.00000
Neg Pred Value 0.96364
Prevalence 0.13115
Detection Rate 0.09836
Detection Prevalence 0.09836
Balanced Accuracy 0.87500
- Random Forest com oversampling
set.seed(42)
model_rf_up_m2bup <- caret::train(Tipo ~ .,
data = train_data,
method = "rf",
ntree = arvores,
preProcess = c("scale", "center"),
trControl = control_Cv_up)
cm_over_m2bup <- caret::confusionMatrix(predict(model_rf_up_m2bup, test_data),
test_data$Tipo)
cm_over_m2bupConfusion Matrix and Statistics
Reference
Prediction X1 X2 X3 X5 X6 X7
X1 18 3 4 0 0 1
X2 3 18 0 0 0 0
X3 0 0 1 0 0 0
X5 0 0 0 3 0 1
X6 0 0 0 0 2 0
X7 0 1 0 0 0 6
Overall Statistics
Accuracy : 0.7869
95% CI : (0.6632, 0.8814)
No Information Rate : 0.3607
P-Value [Acc > NIR] : 1.263e-11
Kappa : 0.6992
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: X1 Class: X2 Class: X3 Class: X5 Class: X6
Sensitivity 0.8571 0.8182 0.20000 1.00000 1.00000
Specificity 0.8000 0.9231 1.00000 0.98276 1.00000
Pos Pred Value 0.6923 0.8571 1.00000 0.75000 1.00000
Neg Pred Value 0.9143 0.9000 0.93333 1.00000 1.00000
Prevalence 0.3443 0.3607 0.08197 0.04918 0.03279
Detection Rate 0.2951 0.2951 0.01639 0.04918 0.03279
Detection Prevalence 0.4262 0.3443 0.01639 0.06557 0.03279
Balanced Accuracy 0.8286 0.8706 0.60000 0.99138 1.00000
Class: X7
Sensitivity 0.75000
Specificity 0.98113
Pos Pred Value 0.85714
Neg Pred Value 0.96296
Prevalence 0.13115
Detection Rate 0.09836
Detection Prevalence 0.11475
Balanced Accuracy 0.86557
- Random Forest com undersampling
set.seed(42)
model_rf_down_m2bunder <- caret::train(Tipo ~ .,
data = train_data,
method = "rf",
ntree = arvores,
preProcess = c("scale", "center"),
trControl = control_Cv_down)
cm_down_m2bunder <- caret::confusionMatrix(predict(model_rf_down_m2bunder, test_data),
test_data$Tipo)
cm_down_m2bunderConfusion Matrix and Statistics
Reference
Prediction X1 X2 X3 X5 X6 X7
X1 15 4 1 0 0 1
X2 2 12 2 0 0 0
X3 4 3 2 0 0 0
X5 0 2 0 3 0 1
X6 0 0 0 0 2 0
X7 0 1 0 0 0 6
Overall Statistics
Accuracy : 0.6557
95% CI : (0.5231, 0.7727)
No Information Rate : 0.3607
P-Value [Acc > NIR] : 2.711e-06
Kappa : 0.5433
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: X1 Class: X2 Class: X3 Class: X5 Class: X6
Sensitivity 0.7143 0.5455 0.40000 1.00000 1.00000
Specificity 0.8500 0.8974 0.87500 0.94828 1.00000
Pos Pred Value 0.7143 0.7500 0.22222 0.50000 1.00000
Neg Pred Value 0.8500 0.7778 0.94231 1.00000 1.00000
Prevalence 0.3443 0.3607 0.08197 0.04918 0.03279
Detection Rate 0.2459 0.1967 0.03279 0.04918 0.03279
Detection Prevalence 0.3443 0.2623 0.14754 0.09836 0.03279
Balanced Accuracy 0.7821 0.7214 0.63750 0.97414 1.00000
Class: X7
Sensitivity 0.75000
Specificity 0.98113
Pos Pred Value 0.85714
Neg Pred Value 0.96296
Prevalence 0.13115
Detection Rate 0.09836
Detection Prevalence 0.11475
Balanced Accuracy 0.86557
Cenário C
De maneira similar ao Cenário A, das “novas” variáveis, manteremos apenas a abordagem considerando as variáveis transformadas como \(X^2\).
df_pred2 <- df %>%
dplyr::mutate(Fe_2 = Fe^2,
Ca_2 = Ca^2)
{
set.seed(42)
index <- caret::createDataPartition(df_pred2$Tipo, p = 0.7, list = FALSE) # particao
train_data <- df_pred2[index, ]
test_data <- df_pred2[-index, ]
}- Random Forest sem reamostragem (original)
set.seed(42)
model_rf_m2cori <- caret::train(Tipo ~ .,
data = train_data,
method = "rf",
ntree = arvores,
preProcess = c("scale", "center"),
trControl = control_Cv_orig)
cm_original_m2cori <- caret::confusionMatrix(predict(model_rf_m2cori, test_data),
test_data$Tipo)
cm_original_m2coriConfusion Matrix and Statistics
Reference
Prediction X1 X2 X3 X5 X6 X7
X1 17 4 4 0 0 2
X2 4 18 0 1 1 0
X3 0 0 1 0 0 0
X5 0 0 0 2 0 0
X6 0 0 0 0 1 1
X7 0 0 0 0 0 5
Overall Statistics
Accuracy : 0.7213
95% CI : (0.5917, 0.8285)
No Information Rate : 0.3607
P-Value [Acc > NIR] : 1.099e-08
Kappa : 0.5967
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: X1 Class: X2 Class: X3 Class: X5 Class: X6
Sensitivity 0.8095 0.8182 0.20000 0.66667 0.50000
Specificity 0.7500 0.8462 1.00000 1.00000 0.98305
Pos Pred Value 0.6296 0.7500 1.00000 1.00000 0.50000
Neg Pred Value 0.8824 0.8919 0.93333 0.98305 0.98305
Prevalence 0.3443 0.3607 0.08197 0.04918 0.03279
Detection Rate 0.2787 0.2951 0.01639 0.03279 0.01639
Detection Prevalence 0.4426 0.3934 0.01639 0.03279 0.03279
Balanced Accuracy 0.7798 0.8322 0.60000 0.83333 0.74153
Class: X7
Sensitivity 0.62500
Specificity 1.00000
Pos Pred Value 1.00000
Neg Pred Value 0.94643
Prevalence 0.13115
Detection Rate 0.08197
Detection Prevalence 0.08197
Balanced Accuracy 0.81250
- Random Forest com oversampling
set.seed(42)
model_rf_up_m2cup <- caret::train(Tipo ~ .,
data = train_data,
method = "rf",
ntree = arvores,
preProcess = c("scale", "center"),
trControl = control_Cv_up)
cm_over_m2cup <- caret::confusionMatrix(predict(model_rf_up_m2cup, test_data),
test_data$Tipo)
cm_over_m2cupConfusion Matrix and Statistics
Reference
Prediction X1 X2 X3 X5 X6 X7
X1 18 3 5 0 0 1
X2 3 17 0 0 0 0
X3 0 1 0 0 0 0
X5 0 0 0 3 0 1
X6 0 0 0 0 2 0
X7 0 1 0 0 0 6
Overall Statistics
Accuracy : 0.7541
95% CI : (0.6271, 0.8554)
No Information Rate : 0.3607
P-Value [Acc > NIR] : 4.418e-10
Kappa : 0.653
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: X1 Class: X2 Class: X3 Class: X5 Class: X6
Sensitivity 0.8571 0.7727 0.00000 1.00000 1.00000
Specificity 0.7750 0.9231 0.98214 0.98276 1.00000
Pos Pred Value 0.6667 0.8500 0.00000 0.75000 1.00000
Neg Pred Value 0.9118 0.8780 0.91667 1.00000 1.00000
Prevalence 0.3443 0.3607 0.08197 0.04918 0.03279
Detection Rate 0.2951 0.2787 0.00000 0.04918 0.03279
Detection Prevalence 0.4426 0.3279 0.01639 0.06557 0.03279
Balanced Accuracy 0.8161 0.8479 0.49107 0.99138 1.00000
Class: X7
Sensitivity 0.75000
Specificity 0.98113
Pos Pred Value 0.85714
Neg Pred Value 0.96296
Prevalence 0.13115
Detection Rate 0.09836
Detection Prevalence 0.11475
Balanced Accuracy 0.86557
- Random Forest com undersampling
set.seed(42)
model_rf_down_m2cunder <- caret::train(Tipo ~ .,
data = train_data,
method = "rf",
ntree = arvores,
preProcess = c("scale", "center"),
trControl = control_Cv_down)
cm_down_m2cunder <- caret::confusionMatrix(predict(model_rf_down_m2cunder, test_data),
test_data$Tipo)
cm_down_m2cunderConfusion Matrix and Statistics
Reference
Prediction X1 X2 X3 X5 X6 X7
X1 14 5 1 0 0 1
X2 2 12 2 0 0 0
X3 5 2 2 0 0 0
X5 0 2 0 3 0 0
X6 0 0 0 0 2 1
X7 0 1 0 0 0 6
Overall Statistics
Accuracy : 0.6393
95% CI : (0.5063, 0.7584)
No Information Rate : 0.3607
P-Value [Acc > NIR] : 8.991e-06
Kappa : 0.5217
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: X1 Class: X2 Class: X3 Class: X5 Class: X6
Sensitivity 0.6667 0.5455 0.40000 1.00000 1.00000
Specificity 0.8250 0.8974 0.87500 0.96552 0.98305
Pos Pred Value 0.6667 0.7500 0.22222 0.60000 0.66667
Neg Pred Value 0.8250 0.7778 0.94231 1.00000 1.00000
Prevalence 0.3443 0.3607 0.08197 0.04918 0.03279
Detection Rate 0.2295 0.1967 0.03279 0.04918 0.03279
Detection Prevalence 0.3443 0.2623 0.14754 0.08197 0.04918
Balanced Accuracy 0.7458 0.7214 0.63750 0.98276 0.99153
Class: X7
Sensitivity 0.75000
Specificity 0.98113
Pos Pred Value 0.85714
Neg Pred Value 0.96296
Prevalence 0.13115
Detection Rate 0.09836
Detection Prevalence 0.11475
Balanced Accuracy 0.86557
ANÁLISE DE PERFORMANCE
models <- list(original_inicial = model_rf_m1,
original_2a = model_rf_m2aori,
original_2b = model_rf_m2bori,
original_3c = model_rf_m2cori,
over_inicial = model_rf_up_m1,
over_2a = model_rf_up_m2aup,
over_2b = model_rf_m2bori,
over_2c = model_rf_up_m2cup,
under_inicial = model_rf_down_m1,
under_2a = model_rf_down_m2aunder,
under_2b = model_rf_down_m2bunder,
under_2c = model_rf_down_m2cunder)
comparacao <- data.frame(Modelo = names(models),
Kappa = rep(NA, length(models)),
Acuracia = rep(NA, length(models)))
comparacao <- comparacao %>%
dplyr::mutate(Acuracia = c(cm_original_m1$overall[1],
cm_original_m2aori$overall[1],
cm_original_m2bori$overall[1],
cm_original_m2cori$overall[1],
cm_over_m1$overall[1],
cm_over_m2aup$overall[1],
cm_over_m2bup$overall[1],
cm_over_m2cup$overall[1],
cm_down_m1$overall[1],
cm_down_m2aunder$overall[1],
cm_down_m2bunder$overall[1],
cm_down_m2cunder$overall[1]),
Kappa = c(cm_original_m1$overall[2],
cm_original_m2aori$overall[2],
cm_original_m2bori$overall[2],
cm_original_m2cori$overall[2],
cm_over_m1$overall[2],
cm_over_m2aup$overall[2],
cm_over_m2bup$overall[2],
cm_over_m2cup$overall[2],
cm_down_m1$overall[2],
cm_down_m2aunder$overall[2],
cm_down_m2bunder$overall[2],
cm_down_m2cunder$overall[2]
)) %>%
reshape2::melt(id.vars = c("Modelo"))
levels(comparacao$variable) <- c("Kappa", "Acurácia")
plot_x3 <- ggplot(comparacao,
(aes(x = variable,
y = value,
color = Modelo))) +
geom_jitter(width = 0.2, alpha = 0.5, size = 7) +
scale_y_continuous(limits = c(0, 1)) +
labs(title = "",
x = "Índice",
y = "Score",
color = "Legenda") +
theme_bw() +
tema
ggsave(file = "plot_x3.png", plot_x3, width = 11, height = 7, dpi = 700)
shiny::div(plotly::ggplotly(plot_x3),
align = "center")comparacao <- comparacao %>%
dplyr::filter(Modelo %in% c("over_inicial", "original_2a", "original_2b", "over_2b"))
plot_x2 <- ggplot2::ggplot(comparacao,
(aes(x = variable,
y = value,
color = Modelo))) +
geom_jitter(width = 0.2, alpha = 0.5, size = 7) +
labs(title = " ",
x = "Índice",
y = "Score",
color = "Legenda") +
theme_bw() +
tema
ggsave(file = "plot_x2.png", plot_x2, width = 13, height = 9, dpi = 700)
shiny::div(plotly::ggplotly(plot_x2),
align = "center")df1 <- data.frame(cm_over_m1[["byClass"]], modelo = "cm_over_m1")
df3 <- data.frame(cm_original_m2bori[["byClass"]], modelo = "cm_original_m2bori")
plot_x1 <- df1 %>%
rbind(df3) %>%
cbind(classe = rep(paste0(rep('X', 6), setdiff(1:7, 4)), 2)) %>%
dplyr::select(1, 2, 7, 12, 13) %>%
tidyr::gather("Metrica", "Valor", -modelo, -classe) %>%
dplyr::mutate(Metrica = as.factor(Metrica),
Metrica = forcats::fct_recode(Metrica, "Sensibilidade" = "Sensitivity"),
Metrica = forcats::fct_recode(Metrica, "Especificidade" = "Specificity"),
modelo = forcats::fct_recode(modelo, "Overs. Cenário 1" = "cm_over_m1"),
modelo = forcats::fct_recode(modelo, "Orig. Cenário 2 - B" = "cm_original_m2bori")) %>%
ggplot2::ggplot() +
geom_jitter(aes(x = Metrica, y = Valor, col = modelo), alpha = 0.5, size = 7) +
facet_wrap(~classe, ncol = 6) +
ylab("Score") + xlab("Métrica") +
theme_bw() +
tema +
theme(axis.text.x = element_text(angle = 90, hjust = 1))
ggsave(file = "plot_x1.png", plot_x1, width = 13, height = 7, dpi = 700)
shiny::div(plotly::ggplotly(plot_x1),
align = "center")
Analisando o gráfico acima, podemos observar que os modelo com dados oversampling com o conjunto de dados sem transformação ou incremento de vriáveis apresentou melhor socore de Acurácia e Kappa ao que os outros modelos.
Outra análise que pode ser feita, para a comparação dos modelos, é a análise da curva ROC, na qual temos plotados valores de Sensitividade e Especificidade, para diversos thresholds.
# Importancia de variaveis por Ínice Gini
gini <- varImp(model_rf_up_m1)$importance %>%
as.data.frame() %>%
tibble::rownames_to_column() %>%
dplyr::arrange(Overall) %>%
dplyr::mutate(rowname = forcats::fct_inorder(rowname)) %>%
ggplot2::ggplot() +
geom_col(aes(x = rowname,
y = Overall,
fill = rowname),
col = "black", show.legend = F) +
coord_flip() +
scale_fill_grey() +
ggtitle("Random Forest - Oversampling - Cenário Inicial") +
xlab("Variável") + ylab("Overall") +
theme_bw() +
tema
ggsave(file = "gini.png", gini, width = 13, height = 9, dpi = 700)
shiny::div(plotly::ggplotly(gini), align = "center")# OOB
plot_oob <- model_rf_up_m1$finalModel[["err.rate"]] %>%
as.data.frame() %>%
dplyr::mutate(Arvores = 1:arvores) %>%
tidyr::gather("Var", "Erro", -Arvores) %>%
ggplot2::ggplot() +
geom_line(aes(x = Arvores, y = Erro, col = Var),
size = 1) +
xlab("N° Árvores") + ylab("Erro") +
theme_minimal_hgrid(12) +
theme(legend.position = "bottom") + tema
ggsave(file = "plot_oob.png", plot_oob, width = 11, height = 7, dpi = 700)
shiny::div(plotly::ggplotly(plot_oob), align = "center")
Para a construção da curva ROC, são construídos, inicialmente, modelos binomiais de uma determinada classe vs todas as outras, ex:
Modelo 1: X1 vs c(X2,X3,X5,X6,X7)
Assim, são calculados os valores de Sensitividade e Especificidade para diversos thresholds. Com todas as classes plotadas, é feita uma curva que é o valor médio de todas as outras em um determinado intervalo de confiança: Macro e Micro indicados no plot e com maior opacidade.
CONSIDERAÇÕES FINAIS
aa…
Como sugestão para trabalhos futuros, indicamos a aplicação de técnica de modelos de misturas tendo em vista as possíveis sub-populações de distribuição. Sugerimos também a construção de modelos de super learning.
Discentes:
Brenner Silva;
Marcello Pessoa.
Docente:
Karla Esquerre.